home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-smt.el < prev    next >
Encoding:
Text File  |  1995-05-05  |  7.5 KB  |  202 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-smt.el
  4. ;; SUMMARY:      Support routines for Smalltalk inheritance browsing and error parsing.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    26-Jul-90
  12. ;; LAST-MOD:      3-May-95 at 17:15:10 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1990-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;;   See 'smt-class-def-regexp' for regular expression that matches class
  22. ;;   definitions.
  23. ;;            
  24. ;; DESCRIP-END.
  25.  
  26. ;;; ************************************************************************
  27. ;;; Other required Elisp libraries
  28. ;;; ************************************************************************
  29.  
  30. (require 'br-lib)
  31.  
  32. ;;; ************************************************************************
  33. ;;; User visible variables
  34. ;;; ************************************************************************
  35.  
  36. (defvar smt-lib-search-dirs nil
  37.   "List of directories below which Smalltalk Library source files are found.
  38. Subdirectories of Library source are also searched.  A Library is a stable
  39. group of classes.")
  40.  
  41. (defvar smt-sys-search-dirs nil
  42.   "List of directories below which Smalltalk System source files are found.
  43. Subdirectories of System source are also searched.  A System class is one
  44. that is not yet reusable and is likely to change before release.")
  45.  
  46. (defconst smt-narrow-view-to-class nil
  47.  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  48.  
  49. ;;; ************************************************************************
  50. ;;; Internal functions
  51. ;;; ************************************************************************
  52.  
  53. (defun smt-get-classes-from-source (filename &rest ignore)
  54.   "Scans FILENAME and returns cons of class list with parents-class alist.
  55. Handles multiple inheritance.  Assumes file existence and readability have
  56. already been checked."
  57.   (let ((no-kill (get-file-buffer filename))
  58.     classes class parents parent-cons)
  59.     (if no-kill
  60.     (set-buffer no-kill)
  61.       (funcall br-view-file-function filename))
  62.     (save-restriction
  63.       (save-excursion
  64.     (widen)
  65.     (goto-char (point-min))
  66.     (while (re-search-forward smt-class-def-regexp nil t)
  67.       (setq class (buffer-substring (match-beginning 3) (match-end 3))
  68.         parent-cons
  69.         (cons
  70.          (and (match-end 1) (> (match-end 1) 0)
  71.               (list (buffer-substring
  72.                  (match-beginning 1)
  73.                  (match-end 1))))
  74.          class))
  75.       ;; Assume class name not found within a comment.
  76.       (setq classes (cons class classes)
  77.         parents (cons parent-cons parents)))))
  78.     (or no-kill (kill-buffer (current-buffer)))
  79.     (cons classes (delq nil parents))))
  80.  
  81. (defun smt-get-parents-from-source (filename class-name)
  82.   "Scan source in FILENAME and return list of parents of CLASS-NAME.
  83. Assume file existence has already been checked."
  84.     (or (null class-name)
  85.     (let ((br-view-file-function 'br-insert-file-contents))
  86.       (car (car (br-rassoc
  87.               class-name
  88.               (cdr (smt-get-classes-from-source filename))))))))
  89.  
  90. (defun smt-select-path (paths-htable-elt &optional feature-p)
  91.   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
  92. Selection is between path of class definition and path for features associated
  93. with the class."
  94.   (cdr paths-htable-elt))
  95.  
  96. (defun smt-set-case (type)
  97.   "Return string TYPE identifier for use as a class name."
  98.   type)
  99.  
  100. (defun smt-set-case-type (class-name)
  101.   "Return string CLASS-NAME for use as a type identifier."
  102.   class-name)
  103.  
  104. (defun smt-to-class-end ()
  105.   "Assuming point is at start of class, move to best guess start of line after end of class."
  106.   (interactive)
  107.   (goto-char (point-max)))
  108.  
  109. (defun smt-to-comments-begin ()
  110.   "Skip back from current point past any preceding Smalltalk comments.
  111. Presently a no-op."
  112.   )
  113.  
  114. ;;; ************************************************************************
  115. ;;; Internal variables
  116. ;;; ************************************************************************
  117.  
  118. (defconst smt-type-tag-separator "@"
  119.   "String that separates a tag's type from its normalized definition form.
  120. This should be a single character which is unchanged when quoted for use as a
  121. literal in a regular expression.")
  122.  
  123. (defconst smt-subclass-separator
  124.   "\\(variableSubclass:\\|variableWordSubclass:\\|variableByteSubclass:\\|subclass:\\)"
  125.   "Regexp matching delimiter following parent identifier.")
  126.  
  127. (defconst smt-identifier-chars "a-zA-Z0-9"
  128.   "String of chars and char ranges that may be used within a Smalltalk identifier.")
  129.  
  130. (defconst smt-identifier (concat "\\([a-zA-Z][" smt-identifier-chars "]*\\)")
  131.   "Regular expression matching a Smalltalk identifier.")
  132.  
  133.  
  134. (defconst smt-class-name-before
  135.   (concat "^[ \t]*" smt-identifier
  136.       "[ \t\n]+" smt-subclass-separator
  137.       "[ \t\n]*#")
  138.   "Regexp preceding the class name in a class definition.")
  139.  
  140. (defconst smt-class-name-after
  141.   ""
  142.   "Regexp following the class name in a class definition.")
  143.  
  144. (defconst smt-class-def-regexp
  145.   (concat smt-class-name-before smt-identifier smt-class-name-after)
  146.   "Regular expression used to match to class definitions in source text.
  147. Class name identifier is grouped expression 3.  'subclass:' inheritance
  148. indicator is grouped expression 2.  Parent identifier is grouped
  149. expression 1.")
  150.  
  151.  
  152. (defconst smt-lang-prefix "smt-"
  153.  "Prefix string that starts \"br-smt.el\" symbol names.")
  154.  
  155. (defconst smt-file-dir-regexp "^[^.~#].*[^.~#]$"
  156.   "Regexp that ignores extraneous non-source files and directories.")
  157.  
  158. (defconst smt-src-file-regexp ".\\.st$"
  159.   "Regular expression matching a unique part of Smalltalk source file name and no others.")
  160.  
  161. (defvar smt-children-htable nil
  162.   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
  163. Used to traverse Smalltalk inheritance graph.  'br-build-children-htable' builds
  164. this list.")
  165. (defvar smt-parents-htable nil
  166.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  167. Used to traverse Smalltalk inheritance graph.  'br-build-parents-htable' builds
  168. this list.")
  169. (defvar smt-paths-htable nil
  170.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  171. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  172. 'br-build-paths-htable' builds this list.")
  173.  
  174.  
  175. (defvar smt-lib-parents-htable nil
  176.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  177. Only classes from stable software libraries are used to build the list.")
  178. (defvar smt-lib-paths-htable nil
  179.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  180. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  181. Only classes from stable software libraries are used to build the list.")
  182.  
  183. (defvar smt-sys-parents-htable nil
  184.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  185. Only classes from systems that are likely to change are used to build the list.")
  186. (defvar smt-sys-paths-htable nil
  187.   "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  188. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  189. Only classes from systems that are likely to change are used to build the
  190. list.")
  191.  
  192. (defvar smt-lib-prev-search-dirs nil
  193.   "Used to check if 'smt-lib-classes-htable' must be regenerated.")
  194. (defvar smt-sys-prev-search-dirs nil
  195.   "Used to check if 'smt-sys-classes-htable' must be regenerated.")
  196.  
  197. (defvar smt-env-spec nil
  198.   "Non-nil value means Environment specification has been given but not yet built.
  199. Nil means current Environment has been built, though it may still require updating.")
  200.  
  201. (provide 'br-smt)
  202.